home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / PD / Anwendungen / AmiCAD / ARexx / Référencer.AmiCAD < prev    next >
Text File  |  1998-06-17  |  4KB  |  167 lines
  1. /* Ajout des références aux composants du type sélectionné ou spécifié
  2.    © R.Florac, Chez Corbin, 2 juin 1998, v1.00
  3.    $VER: Référencer.AmiCAD 1.00 (© R.Florac, 2 juin 1998) */
  4.  
  5. options results     /* indispensable pour récupérer le résultat des macros */
  6.  
  7. signal on error     /* pour l'interception des erreurs */
  8. signal on syntax
  9.  
  10. 'SELECT("Type de composant à référencer"+CHR(10)+"Résistances"+CHR(10)+"Condensateurs"+CHR(10)+"Diodes"+CHR(10)+"Transistors"+CHR(10)+"Circuits intégrés"+CHR(10)+"Composants spécifiés")'
  11. choix=result
  12. select
  13.     when choix=1 then do
  14.     reference='R'
  15.     type="Rés#?"
  16.     end
  17.     when choix=2 then do
  18.     reference='C'
  19.     type="Cond#?"
  20.     end
  21.     when choix=3 then do
  22.     reference='D'
  23.     type="Diod#?"
  24.     end
  25.     when choix=4 then do
  26.     reference='Q'
  27.     type="Transist#?"
  28.     end
  29.     when choix=5 then do
  30.     reference="CI"
  31.     type=1
  32.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'
  33.     end
  34.     when choix=6 then do
  35.     'ASK("Quel est le nom des"+CHR(10)+"composants à référencer?"+CHR(10)+"Vous pouvez utiliser"+CHR(10)+"les jokers(#?) pour"+CHR(10)+"étendre la sélection")'
  36.     type=result
  37.     if type='' then exit
  38.     'ASK("Quelle est la référence"+CHR(10)+"à donner à ces composants?")'
  39.     reference=result
  40.     if reference='' then exit
  41.     end
  42.     otherwise exit
  43. end
  44. 'N=FIRSTSEL'; obj=result
  45. if type=1 then do
  46.     if obj=0 then do
  47.     'MESSAGE("Marquez les circuits"+CHR(10)+"à référencer ainsi que"+CHR(10)+"ceux déjà référencés avant"+CHR(10)+"d''appeler ce script"+CHR(10)+"S.V.P.")'
  48.     exit
  49.     end
  50.     choix=1
  51. end
  52. else do
  53.     if obj>0 then do
  54.     'REQUEST("Voulez-vous marquer"+CHR(10)+"uniquement les"+CHR(10)+"objets sélectionnés?")'
  55.     choix=result
  56.     end
  57.     else choix=0
  58. end
  59.  
  60. if choix=0 then do
  61.     /* Annulation du marquage éventuel */
  62.     'N=FIRSTSEL:WHILE(N>0,UNMARK(N),N=NEXTSEL(N))'
  63.     /* Marquage et comptage des éléments à référencer */
  64.     'SECURITY(OBJECTS(-1)+10):N=0:I=0:WHILE(I=IF(I+1<=OBJECTS(-1),FINDPART(I+1,"'type'"),0),MARK(I):N=N+1):N'
  65.     n=result
  66. end
  67. else do
  68.     /* Comptage des éléments déjà marqués */
  69.     if type=1 then do
  70.     'SECURITY(OBJECTS(-1)+10):I=0:N=FIRSTSEL:WHILE(N,IF(TYPE(N)==1,I=I+1,UNMARK(N)),N=NEXTSEL(N)):I'
  71.     end
  72.     else 'SECURITY(OBJECTS(-1)+10):I=0:WHILE(N,N=FINDPART(N,"'type'"):IF(N>0,IF(TEST(N)>0,I=I+1,0):N=N+1,0)):I'
  73.     n=result
  74. end
  75. if n=0 then do
  76.     'MESSAGE("Il n''y a aucun"+CHR(10)+"objet de ce type")'
  77.     exit
  78. end
  79.  
  80. /* Test des références, ajout éventuel */
  81. 'SAVEALL(-1)'
  82. call test_references(type,reference)
  83. objet=selection_objet(1,type)
  84. do i=1 to n
  85.     'GETREF('objet')'; ref=result
  86.     if ref=0 then call ajouter_reference(objet,reference)
  87.     else do
  88.     'READTEXT('ref')'
  89.     j=right(result,length(result)-length(reference))
  90.     if j~="" then do
  91.         ref.i=1
  92.     end
  93.     end
  94.     if i<n then objet=selection_objet(objet+1,type)
  95. end
  96.  
  97. /* Écriture des références */
  98. objet=selection_objet(1,type)
  99. numref=0
  100. do i=1 to n
  101.     if ref.i~=1 then do
  102.     numref=numref+1
  103.     do while val.numref=1
  104.         numref=numref+1
  105.     end
  106.     'R=GETREF('objet'):SETTEXT(R,READTEXT(R)+"'numref'")'
  107.     end
  108.     if i<n then do
  109.     objet=selection_objet(objet+1,type)
  110.     end
  111. end
  112.  
  113. exit
  114.  
  115. ajouter_reference: procedure
  116.     parse arg obj,reference
  117.     'LINKREF('obj',WRITE("'reference'",COL('obj')+WIDTH('obj')+5,LINE('obj')+HEIGHT('obj')/2))'
  118.     return
  119. end
  120.  
  121. selection_objet: procedure
  122.     parse arg obj,type
  123.     if type=1 then do
  124.     'R='obj':WHILE(TEST_CIRCUIT(R)==0,R=NEXTSEL(R)):R'
  125.     end
  126.     else do
  127.     'R=FINDPART('obj',"'type'"):WHILE(TEST(R)==0,R=FINDPART(R+1,"'type'")):R'
  128.     end
  129.     return result
  130. end
  131.  
  132. /* Procédure testant et marquant les références déjà existantes */
  133. test_references: procedure expose val.
  134.     parse arg type,reference
  135.     obj=1
  136.     'OBJECTS(-1)';objets=result
  137.     do while obj<=objets
  138.     if type=1 then do
  139.         'RO='obj':WHILE(IF(RO>0,TYPE(RO)<>1,0),RO=NEXTSEL(RO)):RO'; obj=result
  140.     end
  141.     else do
  142.         'FINDPART('obj',"'type'")'; obj=result
  143.     end
  144.     if obj=0 then leave
  145.     'GETREF('obj')'; ref=result
  146.     if ref>0 then do
  147.         'READTEXT('ref')'
  148.         j=right(result,length(result)-length(reference))
  149.         if j~="" then do
  150.         val.j=1
  151.         end
  152.     end
  153.     obj=obj+1
  154.     end
  155.     return
  156. end
  157.  
  158. /* Traitement des erreurs, interruption du programme */
  159. syntax:
  160. erreur=RC
  161. 'MESSAGE("Script Référencer"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  162. exit
  163.  
  164. error:
  165. 'MESSAGE("Script Référencer"+CHR(10)+"Erreur en ligne 'SIGL'")'
  166. exit
  167.